Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/101-125/scopedisk122/bassub/tools.sub

Text File | 1995-03-19 | 11KB | 534 lines

'Numerous subroutines for handling various chores in programs
REM FNstr$
'converts number to string with rounding control
'num = number to be converted
'decimal = number of decimal places to include in returned string
DEF FNstr$(num,decimal)
    digits_left=FIX(num)
    digits_right=FNfrac(num)
    digitr$=LEFT$(STR$(digits_right),decimal+2)
    digitl$=STR$(digits_left)
    FNstr$=FNstrip$(digitl$+digitr$)
END DEF
REM FNfrac
'returns the fractional component of number (Like TRUNC)
DEF FNfrac(x)
    FNfrac=x-FIX(x)
END DEF
REM divide
'returns quotient and remainder of a division of two numbers
'divisor is denominator
'dividend is numerator
SUB divide(divisor,dividend,quotient,rmainder)
    quotient=divisor\dividend
    rmainder=divisor-dividend*quotient
END SUB
REM Pause
'Delay routine
SUB Pause(delay)
    t!=TIMER
    WHILE TIMER < t!+delay
    WEND
END SUB
REM center.msg
'print a centered message in the window
'msg$ = message
'line.num% = line to display message
'wid% = width of window in pixels
SUB center.msg(msg$,line.num%,wid%)
  LOCATE line.num%,1
  PRINT STRING$(wid%/8," ");
  LOCATE line.num%,INT((wid%/8-LEN(msg$))/2)
  PRINT msg$
END SUB
REM blink
'display a blinking message, a$ at blink rate, speed
SUB blink(a$,speed)
  x%=CRSLIN
  y%=POS(0)
  FOR i%=1 TO 10
    LOCATE y%,x%
    PRINT a$;
    CALL PAUSE(speed)
    LOCATE y%,x%
    PRINT STRING$(LEN(a$)," ");
    CALL PAUSE(speed)
  NEXT i%
  LOCATE y%,x%
  PRINT a$
END SUB
REM removestr
'remove substring, substr$ from string, s$
SUB removestr(s$,substr$)
  k%=LEN(substr$)
  l%=INSTR(s$,substr$)
  WHILE l%>0
    IF l%=1
      s$=MID$(s$,(l%+k%))
    ELSE
      s$=MID$(s$,1,(l%-1))+MID$(s$,(l%+k%))
    END IF
    l%=INSTR(s$,substr$)
  WEND
END SUB
REM FNpadleft$
'pad left of string, s$ with l% occurances of character, char$
DEF FNpadleft$(s$,char$,l%)
  IF l%<1
    l%=1
  END IF
  IF LEN(char$)>1
    char$=LEFT$(char$,1)
  END IF
  FNpadleft$=STRING$(l%,char$)+s$
END DEF
REM FNpadright$
'pad right of string, s$ with l% occurances of character, char$
DEF FNpadright$(s$,char$,l%)
  IF l%<1
    l%=1
  END IF
  IF LEN(char$)>1
    char$=LEFT$(char$,1)
  END IF
  FNpadright$=s$+STRING$(l%,char$)
END DEF
REM FNpadcenter$
'pad center of string, s$, beginning at index%, with l% occurances of
'character, char$
DEF FNpadcenter$(s$,char$,l%,index%)
  IF l%<1
    l%=1
  END IF
  IF index%<1
    index%=2
  END IF
  IF index%<LEN(s$)
    IF LEN(char$)>1
      char$=LEFT$(char$,1)
    END IF
    FNpadcenter$=LEFT$(s$,index%-1)+STRING$(l%,char$)+MID$(s$,index%)
  ELSE
    FNpadcenter$=""
  END IF
END DEF
REM FNpadends$
'pad both ends of string, s$ with l% occurances of character, char$
DEF FNpadends$(s$,char$,l%)
  IF l%<1
    l%=1
  END IF
  t$=STRING$(l%,char$)
  FNpadends$=t$+s$+t$
END DEF
REM FNdelleft$
'delete character to left of char$ in string, s$
' If killc%<>0 then char$ also deleted.
DEF FNdelleft$(s$,char$,killc%)
  IF LEN(char$)>1
    char$=LEFT$(char$,1)
  END IF
  l%=INSTR(s$,char$)
  IF l%=0
    FNdelleft$=s$
  ELSEIF (killc%=0) THEN
    DECR l%
  END IF
  FNdelleft$=MID$(s$,l%+1)
END DEF
' Delete all right of first occurance of char$.  Delete char$ if killc%<>0
REM FNdelright$
DEF FNdelright$(s$,char$,killc%)
  IF LEN(char$)>1
    char$=LEFT$(char$,1)
  END IF
  l%=LEN(s$)
  WHILE (MID$(s$,l%,1)<>char$) AND (l%>0)
    DECR l%
  WEND
  IF l%=0
    FNdelright$=s$
  ELSEIF (killc%<>0) THEN
    DECR l%
  END IF
  FNdelright$=LEFT$(s$,l%)
END DEF
REM FNnum.in.range
'determine if number, a, is in range of low and hi
DEF FNnum.in.range(msg$,low,hi)
  wherey%=CRSLIN
  wherex%=POS(0)
  DO
    LOCATE wherey%,wherex%
    PRINT STRING$((80-wherex%)," ");
    LOCATE wherey%,wherex%
    PRINT msg$;
    INPUT " ";a
  LOOP UNTIL (a>=low) AND (a<=hi)
  FNnum.in.range=a
END DEF
REM FNinteger.in.range%
'determine if integer a% is in range of low% and hi%
DEF FNinteger.in.range%(msg$,low%,hi%)
  wherey%=CRSLIN
  wherex%=POS(0)
  DO
    LOCATE wherey%,wherex%
    PRINT STRING$((80-wherex%)," ");
    LOCATE wherey%,wherex%
    PRINT msg$;
    INPUT " ";a%
  LOOP UNTIL (a%>=low%) AND (a%<=hi%)
  FNinteger.in.range%=a%
END DEF
REM FNyesno$
'get a yes/no response
DEF FNyesno$(msg$)
  DO
    LOCATE CRSLIN,POS(0)
    PRINT msg$;
    INPUT " (Y/N) ";a$
    IF LEN(a$)>0
      a$=UCASE$(LEFT$(a$,1))
    END IF
  LOOP UNTIL (a$="N") OR (a$="Y")
  FNyesno$=a$
END DEF
REM FNstrip$
'strips blanks from string, s$
DEF FNstrip$(s$)
    l%=LEN(s$)
    t$=""
    FOR i%=1 TO l%
        c$=MID$(s$,i%,1)
        IF c$<>" " THEN
            t$=t$+c$
        END IF
    NEXT i%
    FNstrip$=t$
END DEF
REM FNRstrip$
'strips blanks at right of string, s$
DEF FNRstrip$(s$)
    l%=LEN(s$)
    FOR i%=l% TO 1 STEP -1
        c$=MID$(s$,i%,1)
        IF c$<>" " THEN
            index%=i%
            EXIT FOR
        END IF
    NEXT i%
    FNRstrip$=LEFT$(s$,index%)
END DEF
REM FNLstrip$
'strips blanks at left of string, s$
DEF FNLstrip$(s$)
    l%=LEN(s$)
    FOR i%=1 TO l%
        c$=MID$(s$,i%,1)
        IF c$<>" " THEN
            index%=i%
            EXIT FOR
        END IF
    NEXT i%
    FNLstrip$=RIGHT$(s$,l%-index%+1)
END DEF
REM FNcheck_num%
'check if string, s$ is an integer
DEF FNcheck_num%(s$)
    l%=LEN(s$)
    FOR i%=1 TO l%
        IF FNisnumber%(MID$(s$,i%,1)) <> TRUE% THEN
            FNcheck_num%=FALSE%
            EXIT SUB
        ELSE
            FNcheck_num%=TRUE%
        END IF
    NEXT i%
END DEF
REM FNischar%
'check if s$ is a printable character
DEF FNischar%(s$)
    IF ASC(s$)>=&H21 AND ASC(s$)<=&H7E THEN
        FNischar%=TRUE%
    ELSE
        FNischar%=FALSE%
    END IF
END DEF
REM FNisnumber%
'check if s$ is an integer
DEF FNisnumber%(s$)
    IF ASC(s$)>=48 AND ASC(s$)<=57 THEN
        FNisnumber%=TRUE%
    ELSE
        FNisnumber%=FALSE%
    END IF
END DEF
REM FNeven
'check if num% is even number
DEF FNeven(num%)
    IF num% MOD 2 = 0 THEN
        FNeven = FALSE%
    ELSE
        FNeven = TRUE%
    END IF
END DEF
REM FNodd
'check if num% is an odd number
DEF FNodd(num%)
    IF num% MOD 2 <> 0 THEN
        FNodd = FALSE%
    ELSE
        FNodd = TRUE%
    END IF
END DEF
REM FNRound!
'round num# to digits%
DEF FNRound!(num#,digits%)
    FNRound!=CLNG(num#*(10^digits%)+.5)/(10^digits%)
END DEF
REM FNgetword$
'extract the getnum% word from string, s$ using delimiting string, delim$
DEF FNgetword$(s$,delim$,getnum%)
      IF getnum%<1 THEN getnum%=1
      IF delim$="" THEN delim$=" "

      n%=getnum%-1
      i%=1
      l%=LEN(s$)

      IF n%=0 THEN
          WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))=0)
              INCR i%
          WEND
          ptr1%=i%
          FNgetword$=MID$(s$,1,ptr1%)
          EXIT DEF
      END IF

      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      IF i%>l%
            FNgetword$=""
            EXIT DEF
      END IF
      IF n%>0 THEN INCR i%

      WHILE (i%<=l%) AND (n%>0)
            IF (FNtestdelim%(s$,delim$,i%)=1) THEN DECR n%
            INCR i%
      WEND

      IF (n%>0)
            FNgetword$=""
      ELSE
            WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
              INCR i%
            WEND
            ptr1%=i%
            n%=1
            WHILE (i%<=l%) AND (n%>0)
              IF (FNtestdelim%(s$,delim$,i%)=1) THEN DECR n%
              INCR i%
            WEND

            FNgetword$=MID$(s$,ptr1%,i%-ptr1%)
      END IF
END DEF
REM FNwordpos
'return the position value of search$ string in string, s$ starting at index%
'strings are delimited by string, delim$
DEF FNwordpos(s$,delim$,search$,index%)
      IF (INSTR(s$,search$)=0)
            FNwordpos=0
      END IF
      IF delim$=""
            delim$=" "
      END IF
      l%=LEN(s$)
      n%=index%-1
      i%=1
      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      IF i%>l%
            FNwordpos=0
      END IF
      IF n%>0
            INCR i%
      END IF
      WHILE (i%<=l%) AND (n%>0)
            IF FNtestdelim%(s$,delim$,i%)=1
              DECR n%
            END IF
            INCR i%
      WEND
      IF n%>0
            FNwordpos=0
      ELSE
            IF i%>1
              DECR i%
            END IF
            ptr%=INSTR(i%,s$,search$)
            count%=1
            WHILE (i%<ptr%)
              IF FNtestdelim%(s$,delim$,i%)=1
                    INCR count%
              END IF
              INCR i%
            WEND
            FNwordpos=count%+index%-1
      END IF
END DEF
REM FNdelword$
'delete count% word in string, s$, starting from start%
'using delimiting string, delim$
DEF FNdelword$(s$,delim$,start%,count%)
      IF delim$=""
            delim$=" "
      END IF
      l%=LEN(s$)
      n%=start%-1
      i%=1
      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      IF n%>0
            INCR i%
      END IF
      WHILE (i%<=l%) AND (n%>0)
            IF FNtestdelim%(s$,delim$,i%)=1
              DECR n%
            END IF
            INCR i%
      WEND
      IF (n%=0)
            WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
              INCR i%
            WEND
            ptr1%=i%-1
            n%=count%
            WHILE (i%<=l%) AND (n%>0)
              IF FNtestdelim%(s$,delim$,i%)=1
                    DECR n%
              END IF
              INCR i%
            WEND
            IF (n%>0) OR (i%>l%)
              FNdelword$=LEFT$(s$,ptr1%-1)
            ELSE
              FNdelword$=LEFT$(s$,ptr1%)+MID$(s$,i%)
            END IF
      END IF
END DEF
REM FNinsertword$
'insert newword$ starting at index% in string, s$
'words are delimited by delimiting string, delim$
DEF FNinsertword$(s$,delim$,newword$,index%)
      IF delim$=""
            delim$=" "
      END IF
      l%=LEN(s$)
      n%=index%
      i%=1
      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      IF n%>0
            INCR i%
      END IF
      WHILE (i%<=l%) AND (n%>0)
            IF FNtestdelim%(s$,delim$,i%)=1
              DECR n%
            END IF
            INCR i%
      WEND
      IF (n%=0)
            ptr%=i%-1
            FNinsertword$=LEFT$(s$,ptr%)+newword$+MID$(s$,ptr%)
      END IF
END DEF
REM FNtestdelim%
'utility routine used by some of these subroutines
DEF FNtestdelim%(s$,delim$,i%)
      IF (INSTR(delim$,MID$(s$,i%-1,1))=0) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            FNtestdelim%= 1
      ELSE
            FNtestdelim%= 0
      END IF
END DEF
'
'The following are useful routines for taking line input from a file
'and breaking up the line into strings or numbers.  Exploden may be
'changed to provide a third subroutine for integers or the numbers
'in array may be changed to integers later in the main program
REM exploden
'breaks a string of numbers, s$, delimited by delimiting string, delim$, into
'numbers in the array nums#()
'returns numbers in nums#() and the number of values in count%
SUB exploden(s$,delim$,nums#(1),count%)
      l%=LEN(s$)
      IF l%=0 THEN
            EXIT SUB
      END IF
      i%=1
      count%=0
      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      ptr1%=i%
      IF (i%=1) THEN
            i%=2
      END IF
      WHILE i%<=l%
            IF FNtestdelim%(s$,delim$,i%)=1 THEN
              INCR count%
              ptr2%=i%-1
              nums#(count%)=VAL(MID$(s$,ptr1%,ptr2%-ptr1%+1))
              WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
                    INCR i%
              WEND
              ptr1%=i%
            END IF
            INCR i%
      WEND
      IF ptr1%<l% THEN
            INCR count%
            nums#(count%)=VAL(MID$(s$,ptr1%))
      END IF
END SUB
REM explodes
'Same as exploden, except that strings are placed in array words$()
SUB explodes(s$,delim$,words$(1),count%)
      l%=LEN(s$)
      IF l%=0 THEN
            EXIT SUB
      END IF
      i%=1
      count%=0
      WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
            INCR i%
      WEND
      ptr1%=i%
      IF (i%=1) THEN
            i%=2
      END IF
      WHILE i%<=l%
            IF FNtestdelim%(s$,delim$,i%)=1 THEN
              INCR count%
              ptr2%=i%-1
              words$(count%)=MID$(s$,ptr1%,ptr2%-ptr1%+1)
              WHILE (i%<l%) AND (INSTR(delim$,MID$(s$,i%,1))>0)
                    INCR i%
              WEND
              ptr1%=i%
            END IF
            INCR i%
      WEND
      IF ptr1%<l% THEN
            INCR count%
            words$(count%)=MID$(s$,ptr1%)
      END IF
END SUB